home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2005 October / PCWOCT05.iso / Software / FromTheMag / The GIMP 2.2.8 / gimp-2.2.8-i586-setup.exe / {app} / share / gimp / 2.0 / scripts / image-structure.scm < prev    next >
Encoding:
GIMP Script-Fu Script  |  2005-06-30  |  7.3 KB  |  165 lines
  1. ;;; image-structure.scm -*-scheme-*-
  2. ;;; Time-stamp: <1998/03/28 02:46:26 narazaki@InetQ.or.jp>
  3. ;;; Author: Shuji Narazaki <narazaki@InetQ.or.jp>
  4. ;;; Version 0.7
  5. ; ************************************************************************
  6. ; Changed on Feb 4, 1999 by Piet van Oostrum <piet@cs.uu.nl>
  7. ; For use with GIMP 1.1.
  8. ; All calls to gimp-text-* have been converted to use the *-fontname form.
  9. ; The corresponding parameters have been replaced by an SF-FONT parameter.
  10. ; ************************************************************************
  11. ;;; Code:
  12.  
  13. (if (not (symbol-bound? 'script-fu-show-image-structure-new-image?
  14.             (the-environment)))
  15.     (define script-fu-show-image-structure-new-image? TRUE))
  16. (if (not (symbol-bound? 'script-fu-show-image-structure-space
  17.             (the-environment)))
  18.     (define script-fu-show-image-structure-space 50))
  19. (if (not (symbol-bound? 'script-fu-show-image-structure-shear-length
  20.             (the-environment)))
  21.     (define script-fu-show-image-structure-shear-length 50))
  22. (if (not (symbol-bound? 'script-fu-show-image-structure-border
  23.             (the-environment)))
  24.     (define script-fu-show-image-structure-border 10))
  25. (if (not (symbol-bound? 'script-fu-show-image-structure-apply-layer-mask?
  26.             (the-environment)))
  27.     (define script-fu-show-image-structure-apply-layer-mask? TRUE))
  28. (if (not (symbol-bound? 'script-fu-show-image-structure-with-layer-name?
  29.             (the-environment)))
  30.     (define script-fu-show-image-structure-with-layer-name? TRUE))
  31. (if (not (symbol-bound? 'script-fu-show-image-structure-with-pad?
  32.             (the-environment)))
  33.     (define script-fu-show-image-structure-with-pad? TRUE))
  34. (if (not (symbol-bound? 'script-fu-show-image-structure-padding-color
  35.             (the-environment)))
  36.     (define script-fu-show-image-structure-padding-color '(255 255 255)))
  37. (if (not (symbol-bound? 'script-fu-show-image-structure-padding-opacity
  38.             (the-environment)))
  39.     (define script-fu-show-image-structure-padding-opacity 25))
  40. (if (not (symbol-bound? 'script-fu-show-image-structure-with-background?
  41.             (the-environment)))
  42.     (define script-fu-show-image-structure-with-background? TRUE))
  43. (if (not (symbol-bound? 'script-fu-show-image-structure-background-color
  44.             (the-environment)))
  45.     (define script-fu-show-image-structure-background-color '(0 0 0)))
  46.  
  47. (define (script-fu-show-image-structure img drawable new-image? space
  48.                     shear-length border apply-layer-mask?
  49.                     with-layer-name? with-pad? padding-color
  50.                     padding-opacity with-background?
  51.                     background-color)
  52.   (if (eq? new-image? TRUE)
  53.       (begin (set! img (car (gimp-image-duplicate img)))
  54.          (gimp-display-new img)))
  55.   (let* ((layers (gimp-image-get-layers img))
  56.      (num-of-layers (car layers))
  57.      (old-width (car (gimp-image-width img)))
  58.      (old-height (car (gimp-image-height img)))
  59.      (new-width (+ (* 2 border) (+ old-width (* 2 shear-length))))
  60.      (new-height (+ (* 2 border) (+ old-height (* space (- num-of-layers 1)))))
  61.      (new-bg #f)
  62.      (layer-names '())
  63.      (layer #f)
  64.      (index 0))
  65.  
  66.     (gimp-context-push)
  67.  
  68.     (gimp-image-resize img new-width new-height 0 0)
  69.     (set! layers (cadr layers))
  70.     (gimp-selection-none img)
  71.     (while (< index num-of-layers)
  72.       (set! layer (aref layers index))
  73.       (if (equal? "Background" (car (gimp-drawable-get-name layer)))
  74.       (begin
  75.         (gimp-layer-add-alpha layer)
  76.         (gimp-drawable-set-name layer "Original Background")))
  77.       (set! layer-names (cons (car (gimp-drawable-get-name layer)) layer-names))
  78.       (if (not (= -1 (car (gimp-layer-get-mask layer))))
  79.       (gimp-layer-remove-mask layer
  80.                   (if (= TRUE apply-layer-mask?)
  81.                       MASK-APPLY
  82.                       MASK-DISCARD)))
  83.       (if (= TRUE with-pad?)
  84.       (begin
  85.         (gimp-selection-layer-alpha layer)
  86.         (gimp-selection-invert img)
  87.         (gimp-layer-set-preserve-trans layer FALSE)
  88.         (gimp-context-set-foreground padding-color)
  89.         (gimp-edit-bucket-fill layer FG-BUCKET-FILL NORMAL-MODE
  90.                                    padding-opacity 0 0 0 0)
  91.         (gimp-selection-none img)))
  92.  
  93.       (gimp-layer-translate layer
  94.                 (+ border shear-length) (+ border (* space index)))
  95.       (gimp-drawable-transform-shear-default layer ORIENTATION-HORIZONTAL
  96.                          (* (/ (car (gimp-drawable-height layer))
  97.                            old-height)
  98.                         (* -2 shear-length))
  99.                          TRUE FALSE)
  100.       (set! index (+ index 1)))
  101.     (set! new-bg (- num-of-layers 1))
  102.     (if (= TRUE with-background?)
  103.     (begin
  104.       (set! new-bg (car (gimp-layer-new img new-width new-height RGBA-IMAGE
  105.                         "New Background" 100 NORMAL-MODE)))
  106.       (gimp-image-add-layer img new-bg num-of-layers)
  107.       (gimp-context-set-background background-color)
  108.       (gimp-edit-fill new-bg BACKGROUND-FILL)))
  109.     (gimp-image-set-active-layer img (aref layers 0))
  110.     (if (= TRUE with-layer-name?)
  111.     (let ((text-layer #f))
  112.       (gimp-context-set-foreground '(255 255 255))
  113.       (set! index 0)
  114.       (set! layer-names (nreverse layer-names))
  115.       (while (< index num-of-layers)
  116.         (set! text-layer (car (gimp-text-fontname img -1 (/ border 2)
  117.                          (+ (* space index) old-height)
  118.                          (car layer-names)
  119.                          0 TRUE 14 PIXELS "Sans")))
  120.         (gimp-layer-set-mode text-layer NORMAL-MODE)
  121.         (set! index (+ index 1))
  122.         (set! layer-names (cdr layer-names)))))
  123.  
  124.     (gimp-image-set-active-layer img new-bg)
  125.  
  126.     (set! script-fu-show-image-structure-new-image? new-image?)
  127.     (set! script-fu-show-image-structure-space space)
  128.     (set! script-fu-show-image-structure-shear-length shear-length)
  129.     (set! script-fu-show-image-structure-border border)
  130.     (set! script-fu-show-image-structure-apply-layer-mask? apply-layer-mask?)
  131.     (set! script-fu-show-image-structure-with-layer-name? with-layer-name?)
  132.     (set! script-fu-show-image-structure-with-pad? with-pad?)
  133.     (set! script-fu-show-image-structure-padding-color padding-color)
  134.     (set! script-fu-show-image-structure-padding-opacity padding-opacity)
  135.     (set! script-fu-show-image-structure-with-background? with-background?)
  136.     (set! script-fu-show-image-structure-background-color background-color)
  137.  
  138.     (gimp-displays-flush)
  139.  
  140.     (gimp-context-pop)))
  141.  
  142. (script-fu-register "script-fu-show-image-structure"
  143.             _"Show Image _Structure..."
  144.             "Show the layer structure of the image"
  145.             "Shuji Narazaki <narazaki@InetQ.or.jp>"
  146.             "Shuji Narazaki"
  147.             "1997"
  148.             "RGB*, GRAY*"
  149.             SF-IMAGE       "image" 0
  150.             SF-DRAWABLE    "Drawable (unused)" 0
  151.             SF-TOGGLE     _"Create new image" script-fu-show-image-structure-new-image?
  152.             SF-ADJUSTMENT _"Space between layers" (cons script-fu-show-image-structure-space '(0 1000 1 10 0 1))
  153.             SF-ADJUSTMENT _"Shear length" (cons script-fu-show-image-structure-shear-length '(1 1000 1 10 0 1))
  154.             SF-ADJUSTMENT _"Outer border" (cons script-fu-show-image-structure-border '(0 250 1 10 0 1))
  155.             SF-TOGGLE     _"Apply layer mask (or discard)" script-fu-show-image-structure-apply-layer-mask?
  156.             SF-TOGGLE     _"Insert layer names" script-fu-show-image-structure-with-layer-name?
  157.             SF-TOGGLE     _"Padding for transparent regions" script-fu-show-image-structure-with-pad?
  158.             SF-COLOR      _"Pad color" script-fu-show-image-structure-padding-color
  159.             SF-ADJUSTMENT _"Pad opacity" (cons script-fu-show-image-structure-padding-opacity '(0 100 1 10 1 0))
  160.             SF-TOGGLE     _"Make new background" script-fu-show-image-structure-with-background?
  161.             SF-COLOR      _"Background color" script-fu-show-image-structure-background-color)
  162.  
  163. (script-fu-menu-register "script-fu-show-image-structure"
  164.              _"<Image>/Script-Fu/Utils")
  165.